C  VERT.F4, JUSTAV, ORDER, ST1000, STAFFN, STFH, VERTX, SETP8, EXPND

	SUBROUTINE VERT
C****** ALWAYS ASSUMES THERE REALLY IS A STAFF 0 **********
C ALWAYS ASSUMES BOTTOM STAFF IS STAFF #0
	COMMON/XRN/ RN(1)/PTR/KWDS(1) /STF/RSTFAC(120),STFF(120) 
CC	COMMON R2,JA,CENTR,J2,R3 /ALFF/INP(1),J0,K0,RL,R4,R5,X,Y,NX
	COMMON R2,JA,CN,J2,R3,R4,R5,R6,R7,R8,R9
	COMMON /JCHAR/IXX,ISEMI,IBLA  /LIMIT/LIMIT,ITEM
	1 /ALFF/INP(1),J0,K0,RL,Q4,Q5,X,Y,NX
	1 ,RN2,RN4,RN5,RSET,JX,JH,RH,NN,KK,JHX,ISTF(0/7)
	1 /RXP/RINP(8),K,SST(8),J,INX,RRT,A,Z,JJ,MX,H(8)
C NFILE HOLDS POINTERS TO START OF EACH FILE IN KWDS ARRAY
	COMMON /NFI/NFILE(1) /RR4/P1,P2,NFCNT
CC	COMMON /NFI/NFILE(1) /RR4/X4,X5,P1,P2,IH,NFCNT
C FIRST FIND OUT WHAT THE CURRENT HEIGHT IS BY DOING 'JV 1'
	NL=0
	XX=0
	NF=2
	NA=1
	NB=NFILE(2)
	DO 1 K=1,ITEM-1
	IF(K.NE.NB)GO TO 4
C NOW UPDATE NA,NB TO SET LIMITS OF AN INPUT FILE
	NF=NF+1
	NA=NB
	NB=NFILE(NF)
4	L=KWDS(K)
	IF(RN(L+1).NE.8.)GO TO 1
	IF(STAFFN(L).NE.0)GO TO 1
	RH=RN(L+8)
	RL=RN(L)
	JX=L
3	IF(RH.EQ.0)CALL SETP8(L,K,NA,NB)
C GO GET SPACE FOR P8 IF NONE THERE
	XX=XX+RN(L+8)
C XX=TOTAL INCHES OF ALL FILES
1	CONTINUE
	R2=R3/XX
C R2=FACTOR FOR CHANGES
	R3=0
	DO 2 K=1,NFCNT
	NA=NFILE(K)
	NB=NFILE(K+1)-1
2	CALL JUSTAV(NA,NB)
	END

	SUBROUTINE JUSTAV(NA,NB)
C ALWAYS ASSUMES BOTTOM STAFF IS STAFF #0
	COMMON /JCHAR/IXX,ISEMI,IBLA 
	COMMON R2,JA,CN,J2,R3,R4,R5
CC	COMMON R2,JA,CENTR,J2,R3 /ALFF/INP(1),J0,K0,RL,R4,R5,X,Y,NX
	COMMON /ALFF/INP(1),J0,K0,RL,Q4,Q5,X,Y,NX
	1 ,RN2,RN4,RN5,RSET,JX,JH,RH,NN,KK,JHX
	1 /XRN/RN(1) /PTR/KWDS(1)
	RSET=-1.0
CC100	IF(R3.EQ.0)GO TO 101
C IF R3.NE.0 = R3=SIZE WANTED, R2 IS THEN CREATED BY NEXT SECTION.
CC	DO 60 K=NA,NB
CC	JX=KWDS(K)
CC	IF(RN(JX+1).NE.8.0)GO TO 60
CC	IF(STAFFN(JX).NE.0)GO TO 60
CC	IF(RN(JX).LT.6.0.OR.RN(JX+8).EQ.0)GO TO 60
C NOW WE'VE FOUND GIVEN SPACE IN INCHES
CC	GO TO 61
CC60	CONTINUE
CC	R2=1.0
CC	RSET=0
C GO FIND TOP, THEN SCALE TO R3 SIZE
CC	GO TO 101
CC61	R2=R3/RN(JX+8)
CC	RSET=-1.0
101	J0=0
	JX=0
	DO 3 K=NA,NB
C NA,NB LIMITS SINGLE FILE WITHIN WHOLE PAGE.
	L=KWDS(K)
	IF(RN(L+1).NE.8)GO TO 3
	RL=RN(L)
C WORDCOUNT
	RN2=STAFFN(L)
	RN4=0
	IF(RL.GE.2.0)RN4=RN(L+4)
	RN5=1.0
	IF(RL.GE.3.0.AND.RN(L+5).NE.0)RN5=RN(L+5)
	IF(RN2.NE.0)GO TO 30
	J0=L
	K0=K
	JX=L
	IF(RL.LT.6.0)GO TO 3
	IF(R2.EQ.0.OR.R2.EQ.1.0)GO TO 3
	IF(RN(L+8).EQ.0)GO TO 3
C JUMP OUT IF P8=0 OR JS=0 OR NOT ENOUGH PARAMS.
	RN(L+8)=RN(L+8)*R2
	J0=0
	GO TO 3
30	IF(R2.NE.0)GO TO 4
C R2=0 MEANS SET P4 OF ALL STAVES TO 0
	IF(RL.LT.2.0)GO TO 3
	RN(L+4)=ST1000(RN4)
C PUTS HEIGHT TO 0.  IF R4.GE.1000 STAFF MAY HAVE OTHER THAN 5 LINES.
	CALL STFH(RN2,RN4,RN5)
	GO TO 3
4	IF(RN2.EQ.0)GO TO 3
C SKIP NEXT IF BOTTOM STAFF (0)
	IF(R2.EQ.1.0)GO TO 3
	R4=0
	X=AMOD(RN4,1000.)
	RN4=RN4-X
C ALL THIS FOR P4=3088, FOR EXAMPLE (3-LINE STAFF)
	IF(RL.GE.2.0)R4=X
C FOUND VERT. POS. OF STAFF
  	X=STAFFN(L)*17.6+R4*RN5
	Y=X*R2
	R4=RN4+R4+(Y-X)/RN5
5	RN(L+4)=R4
	CALL STFH(RN2,R4,RN5)
3	CONTINUE

31	IF(J0.EQ.0)GO TO 200
	CALL SETP8(J0,K0,NA,NB)
200	END

	FUNCTION ST1000(R4)
	ST1000=R4-AMOD(R4,1000.)
C ALL THESE AMODS ARE FOR STAFF PARAM 4 +n000 (LESS OR MORE THAN 5 LINES)
	END

	FUNCTION STAFFN(J)
	COMMON /XRN/RN(1)
	STAFFN=AMOD(RN(J+2),8.0)
	END

	SUBROUTINE STFH(RN2,RN4,RN5)
	COMMON /POSI/STFF(0/7)
C SETS ABSOLUTE STAFF HEIGHT
	IF(RN5.EQ.0)RN5=1.0
	STFF(IFIX(RN2))=123.0*RN2-469.0+AMOD(RN4,1000.)*7.*RN5
	END

	SUBROUTINE STFHX(X,JH)
C FIND ABSOLUTE STAFF HEIGHT OF TOP 2 STAVES
	COMMON /XRN/RN(1)
	R4=0
	IF(RN(JH).GE.2.0)R4=AMOD(RN(JH+4),1000.)
	R5=1.0
	IF(RN(JH).GE.3.0.AND.RN(JH+5).NE.0)R5=RN(JH+5)
	X=STAFFN(JH)*17.6+R4*R5
CC	X=RN(JH+2)*17.6+R4*R5
	END

	SUBROUTINE VERTX
	COMMON R2,JA,CENTR,J2,R3
2	FORMAT(2F)
3	FORMAT('   TYPE VERTICAL SIZE IN INCHES -- '$)
	TYPE 3
	ACCEPT 2,R3
	END

	SUBROUTINE SETP8(J0,K0,NA,NB)
	COMMON/XRN/ RN(1)/PTR/KWDS(1) /STF/RSTFAC(120),STFF(120) 
	COMMON R2,JA,CN,J2,R3,R4,R5
CC	COMMON R2,JA,CENTR,J2,R3 /ALFF/INP(1),L0,M0,RL,R4,R5,X,Y,NX
	COMMON /ALFF/INP(1),L0,M0,RL,Q4,Q5,X,Y,NX
	1 ,RN2,RN4,RN5,RSET,JX,JH,RH,NN,KK,JHX,ISTF(0/7)
	RL=RN(J0)
	IF(R2.EQ.0.AND.RL.GE.2.0)RN(J0+4)=ST1000(RN(J0+4))
13	DO 17 K=0,7
17	ISTF(K)=0
C ISTF WILL HOLD POINTERS ALL STAVES IN THIS FILE
	DO 14 K=NA,NB-1
CCC	DO 14 K=NA,NB
	L=KWDS(K)
	IF(RN(L+1).NE.8)GO TO 14
C WHAT ABOUT INVISIBLE STAVES????*********
	ISTF(IFIX(STAFFN(L)))=L
CC	ISTF(IFIX(RN(L+2)))=L
14	CONTINUE
	DO 18  K=7,0,-1
C FIND HIGHEST AND NEXT-TO-HIGHEST STAFF
	IF(ISTF(K).EQ.0)GO TO 18
	JH=ISTF(K)
	JHX=0
C****** ALWAYS ASSUMES THERE REALLY IS A STAFF 0 **********
19	IF(K.EQ.0)GO TO 15
	IF(ISTF(K-1).NE.0)GO TO 20
	K=K-1
C THERE CAN BE GAPS IN STAFF NUMBERS (ASSUMES STAFF 0 EXISTS!)
	GO TO 19
20	JHX=ISTF(K-1)
	GO TO 15
18	CONTINUE
15	CALL STFHX(X,JH)
16	CALL STFHX(Y,JHX)
	X=X+X-Y
	IF(JHX.EQ.0)X=17.6
C 17.6=17.6+17.6-17.6 NEEDED IF THIS IS STAFF 0
	RN(JX+8)=X/24.1
C SPACES ACCORDING TO SPACE BELOW TOP STAFF.  26.85 VERTICAL STEPS PER INCH
	END

	SUBROUTINE EXPND(JX,J,IX,ITEM)
	COMMON/XRN/ RN(1) /PTR/KWDS(1)
C JX POINTS TO 1ST NEW ITEM
C J = NUM OF NEW ITEMS
C IX = NUM OF WDS ALREADY
C ITEM = NUM OF NEW WDS.
	N=JX+J
C N POINTS TO 1 PAST END OF CURRENT RN ARRAY
	LAST=IX+ITEM-1
	K=JX
	KK=IX-1
1	L=KWDS(K)+KK
	IF(RN(L+1).EQ.8.0)GO TO 2
C LOOK FOR CODE 8
3	K=K+1
	IF(K.LT.N)GO TO 1
	RETURN
2	X=RN(L)
	IF(X.GE.6.0)GO TO 3
C 6 = WD CNT IS BIG ENOUGH
	IF(RN(L+2).EQ.0)GO TO 4
C JUMP IF THIS IS STAFF 0
	IF(X.GE.2.0)GO TO 3
C 2 = WD CNT BIG ENOUGH TO PUT IN P4
	Y=2.0
	GO TO 5
4	Y=6.0
5	NN=Y-X
C DIFFERENCE BETWEEN WD CNT AND WHAT IS NEEDED.
	RN(L)=Y
	L=KWDS(K+1)+KK
	DO 7 MM=LAST+NN,L,-1
C SHIFT DATA AHEAD BY NN WDS.
7	RN(MM)=RN(MM-NN)
	DO 8 MM=L,L+NN-1
C ZERO OUT NEW PARAMS IN CODE 8
8	RN(MM)=0
	DO 9 MM=K+1,N
C UPDATE POINTER LIST
9	KWDS(MM)=KWDS(MM)+NN
	ITEM=ITEM+NN
	LAST=LAST+NN
	GO TO 3
	END

	SUBROUTINE ORDER(ITEM)
	IMPLICIT INTEGER(A-Q,S-Z)
	COMMON /PTR/PWDS(1) /XRN/RN(1)/RR4/P1,P2,NF
	DIMENSION RST(1),WDS(1)
	EQUIVALENCE (RST,RN(10001)),(WDS,PWDS(1251))
C****** CHANGE IF NOT ENOUGH STORAGE SPACE ************
	J=1
	JJ=1
	K1=1
	K2=ITEM
	DO 40 K=0,NF*8-1
10	IF(K1.GT.K2)GO TO 45
C JUMP OUT IF ALL SORTED
	M=0
	RX=9999.
	RK=K
	DO 20 L=K1,K2
	N=PWDS(L)
	IF(N.LT.0)GO TO 20
C SKIP ITEM THAT WAS ALREADY SHUFFLED
	IF(RK.NE.RN(N+2))GO TO 20
C ORDER BY STAVES 
	R=RN(N+3)
CCC	IF(R.EQ.10000.)GO TO 20
C SKIP ITEM THAT WAS ALREADY SHUFFLED
	IF(RN(N+1).EQ.16)GO TO 30
C DO NOT ORDER TEXT. (CODE 16)
	IF(R.GE.RX)GO TO 20
	RX=R
	M=L
20	CONTINUE
	IF(M.EQ.0)GO TO 40
C FOUND NO MORE ON THIS LINE
	L=M
C NOW PUT AWAY NEXT ITEM IN ORDER
CC      DO 3 MM=PWDS(L),PWDS(L+1)-1
CC      RST(J)=RN(MM)
CC3     J=J+1
30	WDS(JJ)=J
	JJ=JJ+1
	M=PWDS(L)
	MM=IABS(PWDS(L+1))-M
C NEXT MOVES RN INTO RST
	CALL RLOOP(RST(J),RN(M),MM)
	J=J+MM
CCCC	RN(PWDS(L)+3)=10000.
C WIPE OUT THIS POSITION, MAKE POINTER NEG.
	PWDS(L)=-M
	IF(L.NE.K1)GO TO 50
C NOW CHECK IF BOT OR TOP OF ARRAY CAN BE SHORTENED
60	K1=K1+1
	IF(PWDS(K1).EQ.0)GO TO 60
	GO TO 10
50	IF(L.NE.K2)GO TO 10
70	K2=K2-1
	IF(PWDS(K2).EQ.0)GO TO 70
	GO TO 10
40	CONTINUE
45	CALL RLOOP(PWDS,WDS,ITEM)
C PUTS WDS INTO PWDS  (NOT ITEM+1 SO LAST NUMBER IS NOT OVERWRITTEN.)
CC      DO 6 K=1,PWDS(ITEM+1)
C AND RN ARRAY
CC6     RN(K)=RST(K+3)
	CALL RLOOP(RN,RST,PWDS(ITEM+1))
C PUT RST BACK INTO RN
	END